home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / packages / upd-copyr.el < prev    next >
Encoding:
Text File  |  1995-06-21  |  9.3 KB  |  256 lines
  1. ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
  2.  
  3. ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
  4. ;;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
  5.  
  6. ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
  7. ;; hacked on by Jamie Zawinski.
  8. ;; hacked upon by Jonathan Stigelman <Stig@hackvan.com>
  9. ;; Keywords: maint
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; XEmacs is free software; you can redistribute it and/or modify it
  14. ;; under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; XEmacs is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ;;; 02139, USA.
  27.  
  28. ;;; Code:
  29.  
  30. ;; #### - this will break if you dump it into emacs
  31. (defconst copyright-year (substring (current-time-string) -4)
  32.   "String representing the current year.")
  33.  
  34. ;;;###autoload
  35. (defvar copyright-do-not-disturb "Free Software Foundation, Inc."
  36.   "*If non-nil, the existing copyright holder is checked against this regexp.
  37. If it does not match, then a new copyright line is added with the copyright
  38. holder set to the value of `copyright-whoami'.") 
  39.  
  40. ;;;###autoload
  41. (defvar copyright-whoami nil
  42.   "*A string containing the name of the owner of new copyright notices.")
  43.  
  44. ;;;###autoload
  45. (defvar copyright-notice-file nil
  46.   "*If non-nil, replace copying notices with this file.")
  47.  
  48. (defvar copyright-files-to-ignore-regex "loaddefs.el$"
  49.   "*Regular expression for files that should be ignored")
  50.  
  51. (defvar current-gpl-version "2"
  52.   "String representing the current version of the GPL.")
  53.  
  54. (defvar copyright-inhibit-update nil
  55.   "If nil, ask the user whether or not to update the copyright notice.
  56. If the user has said no, we set this to t locally.")
  57.  
  58. (defvar copyright-search-limit 2048
  59.   "Portion of file to search for copyright notices")
  60.  
  61. ;;;###autoload
  62. (defun update-copyright (&optional replace ask-upd ask-year)
  63.   "Update the copyright notice at the beginning of the buffer
  64. to indicate the current year.  If optional arg REPLACE is given
  65. \(interactively, with prefix arg\) replace the years in the notice
  66. rather than adding the current year after them.
  67. If `copyright-notice-file' is set, the copying permissions following the
  68. copyright are replaced as well.
  69.  
  70. If optional third argument ASK is non-nil, the user is prompted for whether
  71. or not to update the copyright.  If optional fourth argument ASK-YEAR is
  72. non-nil, the user is prompted for whether or not to replace the year rather
  73. than adding to it."
  74.   (interactive "*P")
  75.   (or (and ask-upd copyright-inhibit-update)
  76.       (and buffer-file-truename
  77.        (string-match copyright-files-to-ignore-regex buffer-file-truename))
  78.       (save-excursion
  79.     (save-restriction
  80.       (widen)
  81.       (goto-char (point-min))
  82.       (narrow-to-region (point-min)
  83.                 (min copyright-search-limit (point-max)))
  84.       ;; Handle abbreviated year lists like "1800, 01, 02, 03"
  85.       ;; or "1900, '01, '02, '03".
  86.       (let ((case-fold-search t)
  87.         p-string holder add-new
  88.         mine current
  89.         cw-current cw-mine last-cw
  90.         (cw-position '(lambda ()
  91.                 (goto-char (point-min))
  92.                 (cond (cw-mine (goto-char cw-mine))
  93.                       ((or (and last-cw (goto-char last-cw))
  94.                        (re-search-forward
  95.                         "copyright[^0-9\n]*\\([-, \t]*\\([0-9]+\\)\\)+"
  96.                         nil t))
  97.                        (and add-new (beginning-of-line 2)))
  98.                       (t (goto-char (point-min)))))))
  99.         ;; scan for all copyrights
  100.         (while (re-search-forward
  101.             (concat "^\\(.*\\)copyright.*\\(" (substring copyright-year 0 2)
  102.                 "\\)?" "\\([0-9][0-9]\\(, \t\\)+\\)*'?"
  103.                 "\\(\\(" (substring copyright-year 2) "\\)\\|[0-9][0-9]\\)\\s *\\(\\S .*\\)$")
  104.             nil t)
  105.           (buffer-substring (match-beginning 0) (match-end 0))
  106.           (setq p-string (buffer-substring (match-beginning 1)
  107.                            (match-end 1))
  108.             last-cw   (match-end 5)
  109.             holder    (buffer-substring (match-beginning 7)
  110.                         (match-end 7))
  111.             current    (match-beginning 6)
  112.             mine       (string-match copyright-do-not-disturb holder)
  113.             cw-current (if mine
  114.                    current
  115.                  (or cw-current current))
  116.             cw-mine (or cw-mine (and mine last-cw))
  117.             ))
  118.         ;; ok, now decide if a new copyright is needed...
  119.         (setq add-new (not cw-mine))
  120.         (or ask-upd add-new
  121.         (message "Copyright notice already includes %s." copyright-year))
  122.         (goto-char (point-min))
  123.         (cond ((and cw-current cw-mine)
  124.            (or ask-upd (message "The copyright is up to date"))
  125.            (copyright-check-notice))
  126.           ((and (or add-new (not cw-current))
  127.             ;; #### - doesn't bother to ask about non-GPL sources
  128.             (or (not ask-upd)
  129.                 (prog1
  130.                 (search-forward "is free software" nil t)
  131.                   (goto-char (point-min))))
  132.             ;; adding a new copyright or one exists already...
  133.             (or add-new last-cw)
  134.             ;; adding a new copyright or the user wants to update...
  135.             (or (not ask-upd)
  136.                 (save-window-excursion
  137.                   (pop-to-buffer (current-buffer))
  138.                   ;; Show user the copyright.
  139.                   (funcall cw-position)
  140.                   (sit-for 0)
  141.                   (or (y-or-n-p "Update copyright? ")
  142.                   (progn
  143.                     (set (make-local-variable
  144.                       'copyright-inhibit-update) t)
  145.                     nil)))))
  146.            ;; The "XEmacs change" below effectively disabled this
  147.            ;; already, so I'm gonna comment it out entirely...  --Stig
  148.            ;; (setq replace
  149.            ;;       (or replace
  150.            ;;           (and ask-year
  151.            ;;                (save-window-excursion
  152.            ;;                  (pop-to-buffer (current-buffer))
  153.            ;;                  (save-excursion
  154.            ;;                    ;; Show the user the copyright.
  155.            ;;                    (goto-char (point-min))
  156.            ;;                    ;;XEmacs change
  157.            ;;                    ;; (sit-for 0)
  158.            ;;                    ;; (y-or-n-p "Replace copyright year? ")
  159.            ;;                    nil
  160.            ;;                    )))))
  161.            (cond (add-new
  162.               ;; the cursor should already be at the beginning of a
  163.               ;; line here...
  164.               (funcall cw-position)
  165.               (setq holder (or copyright-whoami
  166.                        (read-string "New copyright holder: ")))
  167.               (if p-string (insert p-string) (indent-for-comment))
  168.               (insert "Copyright (C) ")
  169.               (save-excursion
  170.                 (insert " " holder "\n"))
  171.               )
  172.              (replace
  173.               ;; #### - check this...
  174.               (beginning-of-line)
  175.               (re-search-forward "copyright\\([^0-9]*\\([-, \t]*\\([0-9]+\\)\\)+\\)"
  176.                          (save-excursion (end-of-line)
  177.                                  (point)))
  178.               (delete-region (match-beginning 1) (match-end 1)))
  179.              (t (insert ", ")
  180.                 ;; This did the wrong thing:  "1990-1992" -> "1990, 1992"
  181.                 ;; Perhaps "1990, 1991, 1992" would be an appropriate 
  182.                 ;; substitution, but "1990-1992" is satisfactory.  --Stig
  183.                 ;;
  184.                 ;; XEmacs addition
  185.                 ;; (save-excursion
  186.                 ;;   (goto-char (match-beginning 1))
  187.                 ;;   (if (looking-at "[0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9]")
  188.                 ;;       (progn (forward-char 4)
  189.                 ;;          (delete-char 1)
  190.                 ;;          (insert ", "))))
  191.                 ))
  192.            (insert copyright-year)
  193.            ;; XEmacs addition
  194.            ;; #### - this assumes lisp and shouldn't
  195.            (if (save-excursion
  196.              (end-of-line)
  197.              (>= (current-column) fill-column))
  198.                (if (= (char-syntax ?\;) ?<)
  199.                (insert "\n;;;")
  200.              (insert "\n  ")))
  201.            (message "Copyright updated to %s%s."
  202.                 (if replace "" "include ") copyright-year)
  203.            (copyright-check-notice)
  204.            ;; show the newly-munged copyright.
  205.            (message "The copyright has been updated")
  206.            (sit-for 1))
  207.           ((not ask-upd)
  208.            (error "This buffer does not contain a copyright notice!"))
  209.           ))))))
  210.  
  211. (defun copyright-check-notice ()
  212.   (if copyright-notice-file
  213.       (let (beg)
  214.     (goto-char (point-min))
  215.     ;; Find the beginning of the copyright.
  216.     (if (search-forward "copyright" nil t)
  217.         (progn
  218.           ;; Look for a blank line or a line with only comment chars.
  219.           (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
  220.           (forward-line 1)
  221.         (with-output-to-temp-buffer "*Help*"
  222.           (princ (substitute-command-keys "\
  223. I don't know where the copying notice begins.
  224. Put point there and hit \\[exit-recursive-edit]."))
  225.           (recursive-edit)))
  226.           (setq beg (point))
  227.           (or (search-forward "02139, USA." nil t)
  228.           (with-output-to-temp-buffer "*Help*"
  229.             (princ (substitute-command-keys "\
  230. I don't know where the copying notice ends.
  231. Put point there and hit \\[exit-recursive-edit]."))
  232.             (recursive-edit)))
  233.           (delete-region beg (point))))
  234.     (insert-file copyright-notice-file))
  235.     (if (re-search-forward
  236.      "; either version \\(.+\\), or (at your option)"
  237.      nil t)
  238.     (progn
  239.       (goto-char (match-beginning 1))
  240.       (delete-region (point) (match-end 1))
  241.       (insert current-gpl-version)))))
  242.  
  243. ;;;###autoload
  244. (defun ask-to-update-copyright ()
  245.   "If the current buffer contains a copyright notice that is out of date,
  246. ask the user if it should be updated with `update-copyright' (which see).
  247. Put this on write-file-hooks."
  248.   (update-copyright nil t t)
  249.   ;; Be sure return nil; if a write-file-hook return non-nil,
  250.   ;; the file is presumed to be already written.
  251.   nil)
  252.  
  253. (provide 'upd-copyr)
  254.  
  255. ;;; upd-copyr.el ends here
  256.